open Ast
open Utils

(*Add : ajoute un noeud de type t au graphe decrit par bloc. 
Si les tableaux sont pas de tailles suffisantes, on reaffecte.
On oublie pas d'augmenter le nombre d'element et on renvoit l'id du noeud que l'on vient d'ajouter*)

let add bloc t= 
  let taille=Array.length bloc.noeuds in
  if bloc.nbElem=taille then 
    begin
      let nouveauN=Array.make (1+2*taille) INIT in
      let nouveauS=Array.make (1+2*taille) "" in
      let nouveauL=Array.make (1+2*taille) [] in
      let nouveauLi=Array.make (1+2*taille) (-1) in
      for i=0 to (bloc.nbElem-1) do
	nouveauN.(i)<-bloc.noeuds.(i);
	nouveauLi.(i)<-bloc.link.(i);
	nouveauL.(i)<-bloc.ladj.(i);
	nouveauS.(i)<-bloc.names.(i)
      done;
      nouveauN.(bloc.nbElem)<-t;
      bloc.ladj<-nouveauL;
      bloc.link<-nouveauLi;
      bloc.names<-nouveauS;
      bloc.noeuds<-nouveauN;
      bloc.nbElem<-bloc.nbElem+1;
      bloc.nbElem-1
    end    
  else begin
      bloc.noeuds.(bloc.nbElem)<-t;
      bloc.nbElem<-bloc.nbElem+1;
      bloc.nbElem-1
    end;;
      
(*
La partie un peu bordelique, on a 2 graphes décrits par des blocs, il faut "copier" celui de la fonction appelée
en liant les variables d'entrees et les portes IN d'entrées . 
*)      
    
let applyFunc name toApply bloc =
  let nbToAdd = toApply.nbElem in
  let toAdd = bloc.nbElem in
    for i=0 to (nbToAdd-1) do
      let nouveau=add bloc (toApply.noeuds.(i)) in (
	bloc.names.(nouveau) <- toApply.names.(i)^"_"^name; 
      )
    done;
    for i=0 to (nbToAdd-1) do
      bloc.ladj.(i+toAdd)<- List.map (function x -> x + toAdd) toApply.ladj.(i);
      bloc.link.(i+toAdd)<-toApply.link.(i)+toAdd
    done;
    let listeEntree = List.map (function x -> x + toAdd) toApply.entrees in
    let listeSortie = List.map (function x -> x + toAdd) toApply.sorties in      
    (listeEntree,listeSortie);;

(*
traite une expression de facon recursive renvoit l'id du noeud contenant le resultat de l'evaluation
*)

let rec addn bloc t = function 
  | 0 -> []
  | n -> (add bloc t)::(addn bloc t (n-1));;

let rec readExp vars func bloc = function
  |Variable(s) -> (
    try
      let node=Hashtbl.find vars s in 
      [node]
    with _ -> let id=add bloc IN in Hashtbl.add vars s id;[id] )
    
  |Value(true) ->  let id=add bloc TRUE in 
		   [id] (* a ameliorer 2 gros noeuds true false *)
  |Value(false) -> let id=add bloc FALSE in 
		   [id]
					 
  |Appel(name,l) ->(
    try 
      let t=toPorte name in
      match (t,l) with 

	| (NOT,a::[])  -> 
	  let id=add bloc t in
	  let valA= List.hd (readExp vars func bloc a) in
	  bloc.ladj.(valA)<-id::bloc.ladj.(valA);
	  [id]
	    
	| (REG,a::[]) ->
	  let idI=add bloc REGIN in
	  let idO=add bloc REGOUT in
	  let valA= List.hd (readExp vars func bloc a) in
	  bloc.ladj.(valA)<-idI::bloc.ladj.(valA);
	  bloc.link.(idO)<-idI;
	  
	  [idO]
	
	| (RAM,l) | (ROM,l)->
	  let entrees = addn bloc t 65 in
	  let sorties = addn bloc (rmtoOut t) 32 in
	  let listeEntreeA = List.map (readExp vars func bloc) l in
	  let listeEntree = List.map List.hd listeEntreeA in
	  let rec connect = function 
	    |[]->()
	    |[t]->()
	    |t::b::q-> bloc.ladj.(t)<-b::bloc.ladj.(t);connect (b::q) in
	  connect entrees;
	  let last = List.hd (List.rev entrees) in
	  bloc.ladj.(last)<-(List.hd sorties)::bloc.ladj.(last);
	  connect sorties;
	  List.iter2 (fun x -> fun y-> bloc.ladj.(x)<-y::bloc.ladj.(x)) listeEntree entrees;
	  sorties	

	| (_,a::b::[])->
	  let id=add bloc t in
	  let valA=List.hd (readExp vars func bloc a) in
	  let valB=List.hd (readExp vars func bloc b) in
	  bloc.ladj.(valA)<-id::bloc.ladj.(valA);
	  bloc.ladj.(valB)<-id::bloc.ladj.(valB);
	  [id]

	| (_,_) -> failwith("Erreur lors de l'utilisation d'une porte")
    with _->( 
      let listeId = ref [] in
      List.iter (function x -> listeId:=(!listeId)@(readExp vars func bloc x)) l;
      (*listeId:=List.rev (!listeId);*)
      try
	let fonc=Hashtbl.find func name in
	let (listeEntrees,listeSorties)=applyFunc name fonc bloc in
	let f x y = bloc.ladj.(x)<-y::(bloc.ladj.(x)) in
	List.iter2 f (!listeId) listeEntrees;
	listeSorties
      with _ -> (failwith("appel de bloc "^name^" inconnu"))
    ))
  |_ -> failwith("erreur readExp");;

(* la fontion qui desoptimise ... si on a deja ajoute un noeud IN qui a le meme nom, 
il faut relier le noeud que l'on affecte et le noeud IN*)
let reAffect vars bloc nom noeud = 
  if Hashtbl.mem vars nom then
    let ancien=Hashtbl.find vars nom in
    try
      bloc.ladj.(noeud)<-ancien::bloc.ladj.(noeud);
      Hashtbl.add vars nom noeud;
      bloc.names.(noeud)<-nom
    with _ -> failwith("Acces en au noeud "^(string_of_int noeud))
  else begin
    Hashtbl.add vars nom noeud;
    try
      bloc.names.(noeud)<-nom
    with _ -> failwith("Acces en au noeud "^(string_of_int noeud))
  end;;
(* ajoute une variable a la table de hash*)
let readAffectation vars func bloc = function
    Affectation(lnames,t::[])->
      let listeSorties=readExp vars func bloc t in
      let f = reAffect vars bloc in
	List.iter2 f lnames listeSorties
  | Affectation (lnames,lfonc) ->
      let listeSorties = List.flatten (List.map (function x -> readExp vars func bloc x) lfonc) in
      let f = reAffect vars bloc in
	List.iter2 f lnames listeSorties
  |_->failwith("erreur matching readAffectation");;

(*traite un bloc en lisant toutes les affectations ... renvoit une paire, le nom du bloc et sa description*)
let readBloc func ast =  
    let vars = Hashtbl.create 17 in
    let bloc = {entrees=[];sorties=[];bools=[];rego=[];link=[||];ladj=[||];names=[||];noeuds=[||];nbElem=0} in
    match ast with
      |Bloc(name,lentrees,lsorties,laffect) ->
	List.iter (function x -> 
	  let id = (add bloc IN) in
	  Hashtbl.add vars x id;
	  bloc.names.(id)<-x;
	  bloc.entrees<-id::bloc.entrees) (lentrees);
	bloc.entrees<-(List.rev bloc.entrees);
	List.iter (function x -> readAffectation vars func bloc x) laffect;
	List.iter (function x -> 
	  try
	    let id = Hashtbl.find vars x in
	    bloc.sorties<-id::bloc.sorties
	  with _ -> failwith("fuck"^x)) (lsorties);
	bloc.sorties<-(List.rev bloc.sorties);
	(name,bloc)
      |_->failwith("erreur matching readBloc");;

let djaLu = Hashtbl.create 31;;
let func = Hashtbl.create 31;;

let rec readProgram = function
  |Program([],lBloc) -> 
    
    List.iter (function x -> 
      let (n,b) = readBloc func x in
      Hashtbl.add func n b) lBloc 
      
  | Program(Include(t)::q,lBloc) ->
    if not (Hashtbl.mem djaLu t) then begin
      let file=open_in t in
      let lexbuf = Lexing.from_channel file in
      let ast = List.hd (simplify (Grammar.program cacheHandler lexbuf)) in
      Hashtbl.add djaLu t true;
      readProgram ast
    end;
    readProgram (Program(q,lBloc))
  |_->failwith("erreur matching readProgram");;
